---
title: "BBC Director General Conjoint"
author: Sara B. Hobolt, Thomas J. Leeper, and James Tilley
date: 27 April 2018
header-includes:
  - \usepackage[utf8]{inputenc}
  - \usepackage{times}
  - \renewcommand{\thefigure}{S\arabic{figure}}
  - \usepackage[normalem]{ulem}
  - \usepackage{sectsty}
  - \subsectionfont{\normalfont\large\underline}
output:
  pdf_document:
    toc: true
    toc_depth: 2
---

```{r hidden, eval=FALSE, echo=FALSE, results="hide"}
# rmarkdown::render('bbc-analysis.Rmd', encoding = 'UTF-8')
```

```{r knitr_options, echo=FALSE, results="hide"}
knitr::opts_chunk$set(cache = TRUE, echo=FALSE, results="hold", warning=FALSE, dpi=300, fig.width=8, fig.height=8)
options(scipen = 10)
```

```{r packages, echo=FALSE, results="hide", message=FALSE}
library("rio")          # data import/export
library("cregg")        # conjoint analysis
```

```{r load_data, echo=FALSE, results="hide"}
# BBC conjoint
if (!file.exists("bbc-data-stacked.rds")) {
    source("bbc-analysis-cleaning.R", echo = TRUE, encoding = "UTF-8")
}
conj_bbc <- cj_df(rio::import("bbc-data-stacked.rds"))
design_formula <- outcome ~ name + age + experience + degree + occupation + party + eu
```

\clearpage

# Descriptive Statistics and Main Results

This section provides some descriptive statistics from the study and reproduces the main results. The source code for this document fully reproduces the reported figures.

```{r descriptives}
amm_remain <- cregg::mm(design_formula, data = conj_bbc[conj_bbc$id_brexit %in% "A Remainer",], id = ~ ID, weights = ~Weight)
amm_leave <- cregg::mm(design_formula, data = conj_bbc[conj_bbc$id_brexit %in% "A Leaver",], id = ~ ID, weights = ~Weight)
amm_remain$identity = "Remain"
amm_leave$identity = "Leave"
plot(rbind(amm_remain, amm_leave), vline = 0.5, feature_headers = FALSE) + ggplot2::facet_wrap(~identity)
```

\clearpage

## Descriptives

This subsection briefly summarizes the distributions of responses to the main outcome questions. The data here and in all subsequent analyses is a "stacked" dataset, wherein each alternative from each profile pair is a row, such that the dataset has `r nrow(conj_bbc)` rows. The levels of features were fully randomized from the following design:

```{r features, results = "asis"}
print(xtable::xtable(cregg::cj_table(~ name + age + experience + degree + occupation + party + eu, data = conj_bbc, id = ~ID)),
      comment = FALSE,
      floating = FALSE,
      include.rownames = FALSE)
```

\clearpage

This plot displays numbers of appearances of each level indicates that within each feature this randomization was successful:

```{r randomizations, fig.width=12, fig.height=8}
plot(cregg::cj_freqs(~ name + age + experience + degree + occupation + party + eu, data = conj_bbc, id = ~ID, weights = ~Weight))
```

We now turn to distributions of outcome measure. Given the forced choice nature of the design, this means that there are `r nrow(conj_bbc)/2L` 0's and `r nrow(conj_bbc)/2L` 1's for Q1. Respondents were about 2\% less likely to select the righthand option (`r sprintf("diff=%0.2f (se=%0.2f)", summary(lm(outcome ~ AB, data = conj_bbc))$coef[2,1], summary(lm(outcome ~ AB, data = conj_bbc))$coef[2,2])`).

\clearpage

## Main Results

Effects are estimated using ordinary least squares regresion, with standard errors clustered by respondent. 

```{r analysis, fig.width=12, fig.height=8}
amce_fullsample <- cregg::amce(conj_bbc, design_formula, id = ~ID)
```

The figure below shows the main results for the entire sample of respondents (unweighted):

```{r analysis_plot, fig.width=12, fig.height=8, dependson = "analysis"}
plot(amce_fullsample)
```

\clearpage

Full numerical results, split by Leave and Remain identity, are as follows:

```{r analysis_split, results = "asis"}
amce_remain <- cregg::amce(design_formula, data = conj_bbc[conj_bbc$id_brexit %in% "A Remainer",], id = ~ ID)
amce_leave <- cregg::amce(design_formula, data = conj_bbc[conj_bbc$id_brexit %in% "A Leaver",], id = ~ ID)
amce_remain$identity <- "Remain"
amce_leave$identity <- "Leave"
plot(rbind(amce_remain, amce_leave), vline = 0, xlim = c(-0.3, 0.3), feature_headers = FALSE) + ggplot2::facet_wrap(~identity)
```

\clearpage

Full numerical results, split by Conservative and Labour partisan identity, are as follows:

```{r analysis_splitparty, results = "asis"}
amce_con <- cregg::amce(design_formula, data = conj_bbc[conj_bbc$id_party %in% "Conservative",], id = ~ ID)
amce_lab <- cregg::amce(design_formula, data = conj_bbc[conj_bbc$id_party %in% "Labour",], id = ~ ID)
amce_con$identity <- "Conservative"
amce_lab$identity <- "Labour"
plot(rbind(amce_con, amce_lab), vline = 0, xlim = c(-0.3, 0.3), feature_headers = FALSE) + ggplot2::facet_wrap(~identity)
```

\clearpage

Full numerical results, split by both partisan and Brexit identity, are as follows:

```{r analysis_splitboth, results = "asis", fig.width=12, fig.height=8}
amce_conleave <- cregg::amce(design_formula, data = conj_bbc[conj_bbc$id_party %in% "Conservative" & conj_bbc$id_brexit %in% "A Leaver",], id = ~ ID)
amce_conleave$identity <- "Con.-Leaver"
amce_conremain <- cregg::amce(design_formula, data = conj_bbc[conj_bbc$id_party %in% "Conservative" & conj_bbc$id_brexit %in% "A Remainer",], id = ~ ID)
amce_conremain$identity <- "Con.-Remainer"
amce_lableave <- cregg::amce(design_formula, data = conj_bbc[conj_bbc$id_party %in% "Labour" & conj_bbc$id_brexit %in% "A Leaver",], id = ~ ID)
amce_lableave$identity <- "Lab.-Leaver"
amce_labremain <- cregg::amce(design_formula, data = conj_bbc[conj_bbc$id_party %in% "Labour" & conj_bbc$id_brexit %in% "A Remainer",], id = ~ ID)
amce_labremain$identity <- "Lab.-Remainer"
plot(rbind(amce_conleave, amce_conremain, amce_lableave, amce_labremain), vline = 0, xlim = c(-0.3, 0.3), feature_headers = FALSE) +
  ggplot2::facet_wrap(~identity, nrow = 1L)
```

\clearpage

```{r analysis_mm_splitboth, results = "asis", fig.width=10, fig.height=6}
mm_conleave <- cregg::mm(design_formula, data = conj_bbc[conj_bbc$id_party %in% "Conservative" & conj_bbc$id_brexit %in% "A Leaver",], id = ~ ID)
mm_conleave$partyid <- "Conservative"
mm_conleave$refid <- "Leaver"
mm_conleave$identity <- "Conservative-Leaver"
mm_conremain <- cregg::mm(design_formula, data = conj_bbc[conj_bbc$id_party %in% "Conservative" & conj_bbc$id_brexit %in% "A Remainer",], id = ~ ID)
mm_conremain$partyid <- "Conservative"
mm_conremain$refid <- "Remainer"
mm_conremain$identity <- "Conservative-Remainer"
mm_lableave <- cregg::mm(design_formula, data = conj_bbc[conj_bbc$id_party %in% "Labour" & conj_bbc$id_brexit %in% "A Leaver",], id = ~ ID)
mm_lableave$partyid <- "Labour"
mm_lableave$refid <- "Leaver"
mm_lableave$identity <- "Labour-Leaver"
mm_labremain <- cregg::mm(design_formula, data = conj_bbc[conj_bbc$id_party %in% "Labour" & conj_bbc$id_brexit %in% "A Remainer",], id = ~ ID)
mm_labremain$partyid <- "Labour"
mm_labremain$refid <- "Remainer"
mm_labremain$identity <- "Labour-Remainer"
mm_stacked <- rbind(mm_conleave, mm_conremain, mm_lableave, mm_labremain)
levels(mm_stacked$level)[levels(mm_stacked$level) == "Didn't support a party at the 2017 election"] <- "Didn't support a party"
levels(mm_stacked$level)[levels(mm_stacked$level) == "Supported the Labour Party at the 2017 election"] <- "Labour Party"
levels(mm_stacked$level)[levels(mm_stacked$level) == "Supported the Conservative Party at the 2017 election"] <- "Conservative Party"
levels(mm_stacked$level)[levels(mm_stacked$level) == "Didn't support a side in the EU referendum"] <- "Didn't support a side"
levels(mm_stacked$level)[levels(mm_stacked$level) == "Supported the Remain campaign in the EU referendum"] <- "Remain supporter"
levels(mm_stacked$level)[levels(mm_stacked$level) == "Supported the Leave campaign in the EU referendum"] <- "Leave supporter"
ggplot2::ggplot(subset(mm_stacked, feature %in% c("party", "eu")),
       ggplot2::aes(x = estimate, y = level, colour = identity, fill = identity, shape = identity, group = identity)) + 
  ggplot2::geom_vline(xintercept = 0.5) +
  ggplot2::xlab("Marginal Percentage Accepting Candidate with Given Feature") +
  ggplot2::ylab("") +
  ggplot2::scale_x_continuous(labels = scales::percent, limits = c(0.2,0.8)) +
  ggplot2::geom_point(position = ggstance::position_dodgev(height = 0.75), size = 3) +
  ggplot2::geom_errorbarh(ggplot2::aes(xmin = lower, xmax = upper, group = identity), 
                          size = 0.5, height = 0, position = ggstance::position_dodgev(height = 0.75)) +
  ggplot2::scale_colour_manual(name = "Respondent Identity",
                               values = c("Black", "Black", "Gray", "Gray"),
                               labels = c("Conservative-Leaver", "Conservative-Remainer", "Labour-Leaver", "Labour-Remainer")) +
  ggplot2::scale_fill_manual(name = "Respondent Identity",
                             values = c("Black", "Black", "Gray", "Gray"),
                             labels = c("Conservative-Leaver", "Conservative-Remainer", "Labour-Leaver", "Labour-Remainer")) +
  ggplot2::scale_shape_manual(name = "Respondent Identity",
                              values = c(24, 21, 24, 21),
                              labels = c("Conservative-Leaver", "Conservative-Remainer", "Labour-Leaver", "Labour-Remainer")) +
  ggplot2::guides(fill = ggplot2::guide_legend(title = "Respondent Identity")) +
  ggplot2::facet_wrap(~ feature,
                      ncol = 1L,
                      scales = "free_y",
                      labeller = ggplot2::as_labeller(c(eu = "Candidate's Referendum Position",
                                                        party = "Candidate's Party Position"))
                     ) +
  ggplot2::theme_minimal() +
  ggplot2::theme(
    plot.background = ggplot2::element_rect(fill = "white"),
    panel.grid.major = ggplot2::element_blank(),
    panel.grid.minor = ggplot2::element_blank(),
    strip.text.x = ggplot2::element_text(size = 10, face = "bold")
  )
```

\clearpage

## Results Holding Conjoint Features Constant

The results in this section analyze the conjoint data while holding each feature of the conjoint at a given level. Effectively, this yields conditional effects of each attribute for each level of the attribute being fixed (i.e., interaction effects). The experiment is underpowered in some of these analyses given the ratio of attribute levels to respondents.

Coming Soon!

\clearpage

# Analytic Details

This report was built with rmarkdown, using the following software versions:

```{r sessioninfo}
sessionInfo()
```
